home *** CD-ROM | disk | FTP | other *** search
- ⓪ (*$G+,C-*)⓪ module stichwort;⓪ (*$Z+, [-*)⓪ ⓪ (* Stichwortverzeichnis einlesen und sortieren⓪ ⓪#Format der Eingabedatei:⓪#{ LeadIn [SeitenNr] <cr> | Eintrag <cr> | LeadSpec cardinal SepSign String }⓪#⓪#Format der Ausgabedatei:⓪#{ Eintrag <tab> SeitenNr {',' SeitenNr} }⓪#⓪#Format einer SeitenNr:⓪#integer SepSign integer⓪#⓪#jm 5.10.87 erste Version⓪#jm 2.11.87 SeitenNr nach LeadIn optional; falls keine⓪0SeitenNr angegeben, wird Seite um 1 erhöht;⓪0LeadSpec erlaubt Definition spezieller Kapitelnamen, die⓪0durch entspr. negative Kapitelnummern angesprochen werden⓪%10.12.87 Spaces vor Tabulatoren jetzt nicht mehr nötig⓪0(Signum2 verarbeitet TABs korrekt)⓪%09.10.90 Kapitelnummern können nun trotzdem Seitennummern haben⓪ *)⓪ ⓪ from files import file, access, replacemode, open, create, close, eof;⓪ import text, numberio, FuncStrings, strconv;⓪ from inout import writestring, writeln, readstring, writecard;⓪ from strings import Append, Compare, Relation, StrEqual, Delete,⓪8Assign, Empty, Lower, Length, Pos, PosLen, Copy;⓪ from easygem1 import selectfile;⓪ ⓪ const datsize = 5000;⓪(WortLen = 40;⓪(SepSign = '-';⓪)LeadIn = '#';⓪'LeadSpec = '$';⓪ ⓪ type String = ARRAY [0..255] OF CHAR;⓪&StringWortLen = ARRAY [0..WortLen] OF CHAR;⓪ ⓪ type eintrag = record⓪2stichwort: stringWortLen;⓪4kapitel,⓪6seite: integer⓪0end;⓪ ⓪'daten = array [0..datsize] of eintrag;⓪%spIndex = integer [1..99];⓪ ⓪ var special: array spIndex of string;⓪(ok: BOOLEAN;⓪ ⓪ PROCEDURE StrToInt (ref line: ARRAY OF CHAR): INTEGER;⓪"VAR p: CARDINAL;⓪"BEGIN⓪$p:= 0;⓪$RETURN StrConv.StrToInt (line, p, ok)⓪"END StrToInt;⓪ ⓪ procedure prepare (s: ARRAY OF CHAR): string;⓪"var s1: string;⓪$i, j: cardinal;⓪"begin⓪$Lower (s);⓪$s1 := '';⓪$(*$R-*)⓪$for i:=0 to length (s)-1 do⓪&case s [i] of⓪('ü': Append ('u', s1, ok); Append ('e', s1, ok) |⓪('ä': Append ('a', s1, ok); Append ('e', s1, ok) |⓪('ö': Append ('o', s1, ok); Append ('e', s1, ok) |⓪('ß': Append ('s', s1, ok); Append ('s', s1, ok) |⓪&else⓪(Append (s [i], s1, ok)⓪&end⓪$end;⓪$(*$R=*)⓪$return s1⓪"end prepare;⓪ ⓪ procedure gross (ref d1, d2: eintrag): boolean;⓪"begin⓪$if strequal (d1.stichwort, d2.stichwort) then⓪&if d1.kapitel = d2.kapitel then⓪(return d1.seite > d2.seite⓪&else⓪(return d1.kapitel > d2.kapitel⓪&end⓪$else⓪&return Compare (prepare (d1.stichwort), prepare (d2.stichwort)) = greater⓪&(*⓪(return Compare (FuncStrings.LowStr (d1.stichwort),⓪8FuncStrings.LowStr (d2.stichwort)) = greater⓪&*)⓪$end;⓪"end gross;⓪"⓪ ⓪ procedure mischSort (var d, hilf: daten; start, len: cardinal);⓪"⓪"var start2, len2, i, j, k: cardinal;⓪"⓪"begin⓪$if len > 1 then⓪&len2 := len div 2;⓪&start2 := start + len2;⓪&mischSort (d, hilf, start, len2);⓪&mischSort (d, hilf, start2, len - len2);⓪&⓪&(* solange in beiden Hälften Daten, zusammenmischen *)⓪&⓪&i := start;⓪&j := start2;⓪&k := 0;⓪&while (i < start2) & (j < start+len) do⓪(if gross (d [i], d[j]) then⓪*hilf [k] := d [j]; inc (j)⓪(else⓪*hilf [k] := d [i]; inc (i)⓪(end;⓪(inc (k)⓪&end;⓪&⓪&(* Rest aus übriggebliebener Hälfte übernehmen *)⓪&⓪&if i < start2 then⓪(repeat⓪*hilf [k] := d [i]; inc (k); inc (i)⓪(until k = len⓪&else (* muß Rest bei j sein *)⓪(repeat⓪*hilf [k] := d [j]; inc (k); inc (j)⓪(until k = len⓪&end;⓪*⓪&(* aus dem Hilfsfeld zurückkopieren *)⓪&⓪&for k := 0 to len -1 do⓪(d [start+k] := hilf [k]⓪&end;⓪$⓪$end (* if nichttrivial *)⓪"end mischSort;⓪$⓪ ⓪ procedure einlesen (var d: daten; var len: cardinal);⓪"⓪"var f: file;⓪&line: string;⓪'kap,⓪'sei,⓪)i: integer;⓪ ⓪"begin⓪$kap := 1;⓪$sei := 1;⓪$len := 0;⓪$line:= 'index.roh';⓪$Selectfile ('Roh-Datei?', line, ok);⓪$IF NOT ok THEN RETURN END;⓪$Open (f, line, readSeqTxt);⓪$while not eof (f) do⓪&Text.Readstring (f, line);⓪&if not eof (f) then⓪(if line [0] = LeadIn then⓪*delete (line, 0, 1, ok);⓪*if not empty (FuncStrings.EatSpc (line)) then⓪,kap := StrToInt (line);⓪,delete (line, 0, pos (sepsign, line, 1)+1, ok);⓪,sei := StrToInt (line);⓪*else⓪,inc (sei)⓪*end⓪(elsif line [0] = LeadSpec then⓪*delete (line, 0, 1, ok);⓪*i := StrToInt (line);⓪*delete (line, 0, pos (sepsign, line, 0)+1, ok);⓪*special [i] := line⓪(elsif (line[0] # 0C) then⓪*with d [len] do⓪,copy (line, 0, WortLen, stichwort, ok);⓪,kapitel := kap;⓪,seite := sei;⓪*end;⓪*inc (len)⓪(end;⓪&end⓪$end;⓪$close (f);⓪"end einlesen;⓪"⓪ ⓪ procedure mypos (ref target, source: array of char): INTEGER;⓪"var p: INTEGER;⓪"begin⓪$return poslen (target, source, 0);⓪$(*⓪&p := pos (target, source, 0);⓪&if p >= 0 then⓪(return p⓪&else⓪(return length (source)⓪&end⓪$*)⓪"end mypos;⓪"⓪ ⓪ procedure schreiben (var d: daten; len: cardinal);⓪"⓪"const tab = 9c;⓪"⓪"var i: cardinal;⓪(f: file;⓪%help,⓪%last,⓪%lead: stringWortLen;⓪%name: String;⓪$first,⓪"myfirst: char;⓪&⓪"procedure fwritepage (f: file; k, s: integer);⓪$begin⓪&if k >= 0 then⓪(NumberIO.Writeint (f, k, 0);⓪&else⓪(Text.Writestring (f, special [-k])⓪&end;⓪&if s > 0 then⓪(Text.Write (f, sepsign);⓪(NumberIO.Writeint (f, s, 0);⓪&end⓪$end fwritepage;⓪$⓪"begin⓪$i := 0;⓪$last := '';⓪$lead := 'xxx';⓪$first := 'z';⓪$name:= 'index.gar';⓪$Selectfile ('Gar-Datei?', name, ok);⓪$IF NOT ok THEN RETURN END;⓪$Create (f, name, writeSeqTxt, replaceOld);⓪$while i < len do⓪&with d [i] do⓪(myfirst := cap (stichwort [0]);⓪(case myfirst of⓪*'Ä': myfirst:= 'A'|⓪*'Ö': myfirst:= 'O'|⓪*'Ü': myfirst:= 'U'⓪(else⓪(end;⓪(if myfirst # first then⓪*first := myfirst;⓪*Text.Writeln (f); Text.Writeln (f);⓪*Text.Writestring (f, first);⓪*Text.Writeln (f);⓪(end;⓪(if strequal (stichwort, last) then⓪*Text.Writestring (f, ', ');⓪*fwritepage (f, kapitel, seite);⓪(else⓪*copy (stichwort, 0, mypos (',', stichwort), help, ok);⓪*if strequal (help, lead) then⓪,Text.Writeln (f);⓪,Text.Writestring (f, ' - ');⓪,copy (stichwort, mypos (',', stichwort)+1, 99, help, ok);⓪,Text.Writestring (f, help);⓪,Text.Writestring (f, tab);⓪,fwritepage (f, kapitel, seite);⓪,last := stichwort;⓪*else⓪,Text.Writeln (f);⓪,Text.Writestring (f, stichwort);⓪,Text.Writestring (f, tab);⓪,fwritepage (f, kapitel, seite);⓪,last := stichwort;⓪,copy (stichwort, 0, mypos (',', stichwort), lead, ok);⓪*end;⓪(end⓪&end (* with *);⓪&inc (i)⓪$end (* while *);⓪$Text.Writeln (f);⓪$close (f);⓪"end schreiben;⓪(⓪(⓪ var Liste, Hilf: Daten;⓪,size: cardinal;⓪,⓪ begin⓪"einlesen (liste, size);⓪"writeln; writecard (size, 5); writestring (' Einträge gelesen');⓪"⓪"mischsort (liste, hilf, 0, size);⓪"writeln; writestring (' ... sortiert');⓪"⓪"schreiben (liste, size);⓪"writeln; writestring (' ... geschrieben');⓪ end Stichwort.⓪ ⓪ ə
- (* $FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$00000977$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289F$FFEB289FÇ$00000713T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00000856$000006FA$FFEDCE26$FFEDCE26$FFEDCE26$000006B1$00000856$0000002C$0000071D$00000713$00000856$0000002C$FFEDCE26$00000419$FFEDCE26$00000862ãÇé*)
-
